home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / mac / LOGIC Apple II 5.25" Library - ProDOS / PRO004.dsk / FILES.bas < prev    next >
BASIC Source File  |  2012-02-16  |  6KB  |  149 lines
  1. 10  REM  <<   FILE CABINET    >>
  2. 20  REM  <<   FILES MODULE    >>
  3. 30  REM  <<   PRODOS VERSION  >>
  4. 40  REM  <<   CONVERTED BY    >>
  5. 50  REM  <<   MICHAEL MOORE   >>
  6. 60  REM  <<      MAY 1984     >>
  7. 70 :
  8. 90  IF FLAG = 1  THEN FLAG = 0: GOTO 14100
  9. 100  GOTO 13010: REM     << FILE ROUTINE
  10. 2400  REM  <<<< GET CHOICE >>>>>
  11. 2410  PRINT L$"->":V =  PEEK(37)::H =  LEN(L$) +3
  12. 2420  VTAB V: HTAB H: CALL  -868: INPUT "";R$:R =  VAL(R$): CALL  -958
  13. 2440  PRINT : RETURN 
  14. 2500  REM  <<<< GET YES/NO ANSWER >>>>
  15. 2510 V =  PEEK(37) +1
  16. 2515  PRINT L$" (Y/N)"
  17. 2520  IF V >23  THEN V = 23
  18. 2530  VTAB V: HTAB ( LEN(L$) +8): CALL  -868: INPUT A$: IF A$ = "Y"  THEN YES = 1: RETURN 
  19. 2540  IF A$ = "N"  THEN YES = 0: RETURN 
  20. 2550  INVERSE : PRINT " PRESS 'Y' OR 'N'...": NORMAL : IF V =  >23  THEN V = 22
  21. 2560  GOTO 2530
  22. 13000  REM  <<< LIST DATA BASES >>>>
  23. 13010  HOME 
  24. 13020  VTAB 5: HTAB 10: PRINT "FILE CABINET - PRODOS": PRINT 
  25. 13025  HTAB 12: PRINT "FILE DELETION MENU": PRINT 
  26. 13030  POKE 216,0
  27. 13040  PRINT "SELECT FROM:": PRINT 
  28. 13050  IF   NOT NR  THEN J = 1: GOTO 13070
  29. 13060  FOR J = 1 TO NR: PRINT J" "R$(J): NEXT J: PRINT 
  30. 13070  PRINT J;" RETURN TO MAIN MENU": PRINT 
  31. 14000  REM  <<< FILES ROUTINE >>>>
  32. 14010  PRINT : INPUT "DELETE WHICH -> ";S$:S =  VAL(S$)
  33. 14015  IF S = J  THEN  PRINT D$;"CHAIN";PX$ +"MAIN"
  34. 14020  IF S <1  OR S >J -1  THEN  PRINT  CHR$(7);: VTAB  PEEK(37) -1: CALL  -868: GOTO 14010
  35. 14030  HOME : VTAB (9): PRINT "READY TO DELETE ";: INVERSE : PRINT R$(S);: NORMAL : PRINT ".": PRINT 
  36. 14040  PRINT "ONCE DELETED, THIS DATA CANNOT BE"
  37. 14050  PRINT "RECOVERED.  ARE YOU SURE THAT YOU"
  38. 14060  PRINT "WANT TO DELETE IT? (Y/N) ";: INPUT "";S$
  39. 14070  IF S$ < >"Y"  THEN  GOTO 13010
  40. 14080  HOME : VTAB 12: INVERSE : PRINT "[ DELETING "R$(S)" DATABASE ]": NORMAL 
  41. 14090 FD$ = R$(S)
  42. 14100  ONERR  GOTO 14170
  43. 14110 F$ = "RPTFMTNAME"
  44. 14115  PRINT D$"VERIFY";PB$ +FD$ +"/" +F$
  45. 14120  GOSUB 23010
  46. 14125  VTAB 15: CALL  -868: PRINT "DELETING ";PB$ +FD$ +"/" +F$
  47. 14130  PRINT D$"DELETE";PB$ +FD$ +"/" +F$
  48. 14140  FOR I = 1 TO NR
  49. 14145  VTAB 15: CALL  -868: PRINT "DELETING ";PB$ +FD$ +"/" +"RPTFMT" +R$(I)
  50. 14150  PRINT D$"DELETE";PB$ +FD$ +"/" +"RPTFMT" +R$(I)
  51. 14160  NEXT I
  52. 14170  POKE 216,0: CALL 1013
  53. 14175  VTAB 15: CALL  -868: PRINT "DELETING ";PB$ +FD$ +"/" +"INDEX"
  54. 14180  PRINT D$"DELETE";PB$ +FD$ +"/" +"INDEX"
  55. 14185  VTAB 15: CALL  -868: PRINT "DELETING ";PB$ +FD$ +"/" +"HEADER"
  56. 14190  PRINT D$"DELETE";PB$ +FD$ +"/" +"HEADER"
  57. 14200 R$(0) = FD$
  58. 14210 F$ = "": GOSUB 23010
  59. 14212  IF NR -1 =  >1 GOTO 14221
  60. 14215  VTAB 15: CALL  -868: PRINT "DELETING ";PB$ +"BASENAMES"
  61. 14220  PRINT D$"DELETE";PB$ +"BASENAMES"
  62. 14221  VTAB 15: CALL  -868: PRINT "DELETING ";PB$ +FD$
  63. 14222  PRINT D$"DELETE";PB$ +FD$
  64. 14225  IF NR -1 <1 GOTO 14265
  65. 14229  VTAB 15: CALL  -868: PRINT "SAVING REMAINING FILE NAMES"
  66. 14230 I = 0:J = 1
  67. 14240  IF R$(J) = R$(0)  THEN 14255
  68. 14250 I = I +1:R$(I) = R$(J)
  69. 14255 J = J +1: ON J >NR GOTO 14260: GOTO 14240
  70. 14260 NR = I:F2 = 1: GOSUB 24010
  71. 14265  VTAB 15: CALL  -868: PRINT "RETURNING TO MAIN ROUTINE"
  72. 14270  PRINT D$;"CHAIN";PX$ +"MAIN"
  73. 23000  REM     <<< READ FILE SUB ROUTINE >>>
  74. 23010 FF = 0: IF F$ < >"INDEX"  THEN FF = 1
  75. 23015 Q$ = PB$ +FD$ +"/" +F$
  76. 23017  IF F$ = ""  THEN Q$ = PB$ +"BASENAMES"
  77. 23020  PRINT D$"OPEN";Q$
  78. 23030  PRINT D$"READ";Q$
  79. 23040  INPUT NR
  80. 23050  FOR J = 1 TO NR
  81. 23060  ON FF GOTO 23130
  82. 23070  FOR I = 1 TO NH
  83. 23080  CALL 768,N$(J,I)
  84. 23090 L =  LEN(N$(J,I)): IF L >L%(I)  THEN L%(I) = L
  85. 23100  NEXT I
  86. 23110 R(J) = J
  87. 23120  GOTO 23140
  88. 23130  CALL 768,R$(J)
  89. 23140  NEXT J
  90. 23150  PRINT D$"CLOSE"
  91. 23160 FF = 0
  92. 23170  RETURN 
  93. 24000  REM  <<< WRITE INDEX FILE SUB ROUTINE >>>>
  94. 24010 NR$ =  RIGHT$("00000" + STR$(NR),5)
  95. 24020 FF = 0: IF F$ < >"INDEX"  THEN FF = 1
  96. 24030 Q$ = PB$ +FD$ +"/" +F$
  97. 24032  IF F$ = ""  THEN Q$ = PB$ +"BASENAMES"
  98. 24033  IF F2 = 1 GOTO 24037: REM  FLAG TO PERMIT REWRITE BASENAMES
  99. 24035 R$(I) = RN$(I): IF I <NR  THEN 25030
  100. 24037 F2 = 0: REM  RESET
  101. 24040  PRINT D$"OPEN"Q$: PRINT D$"WRITE"Q$
  102. 24050  PRINT NR$
  103. 24060  FOR J = 1 TO NR
  104. 24070  ON FF GOTO 24130
  105. 24080 Y = R(J)
  106. 24090  FOR I = 1 TO NH
  107. 24100  PRINT N$(Y,I)
  108. 24110  NEXT I
  109. 24120  GOTO 24140
  110. 24130  PRINT R$(J)
  111. 24140  NEXT J
  112. 24150  PRINT D$"CLOSE"
  113. 24160 FF = 0
  114. 24170  RETURN 
  115. 25000  REM  <<< SUBROUTINE >>>
  116. 25030 I = I +1: IF I <NR  AND RN$(NN) = RN$(I)  THEN NR = NR -1
  117. 25040  GOSUB 24010
  118. 25050 NR = NS: RETURN 
  119. 30000  REM  << FILE ROUTINE >>>
  120. 30010  HOME : PRINT "SELECT FROM:": PRINT 
  121. 30020  FOR I = 1 TO NR: PRINT I" "R$(I): NEXT I: PRINT 
  122. 30030 L$ = "DELETE WHICH ":CHOICE = I -1: GOSUB 2410:S = R
  123. 30040  HOME : VTAB 10: PRINT "YOU HAVE SELECTED THE OPTION TO DELETE": INVERSE : PRINT RN$(S)" FORMAT": NORMAL 
  124. 30050 L$ = "IS THIS CORRECT": GOSUB 2510: IF   NOT YES  THEN NR = NS: GOTO 13010
  125. 30060 F$ = RN$(S) +"RPTFMT"
  126. 30070  PRINT D$"DELETE";PB$ +FD$ +"/" +F$
  127. 30080  IF S = NR  THEN 30100
  128. 30090  FOR I = S TO NR -1:RN$(I) = RN$(I +1): NEXT I
  129. 30100 NR = NR -1:F$ = "RPTFMTNAME": IF NR <1  THEN 30130
  130. 30110 I = 0: GOSUB 25030
  131. 30120  PRINT D$;"CHAIN";PX$ +"MAIN"
  132. 30130  PRINT D$"DELETE";PB$ +FD$ +"/" +F$
  133. 30140 NR = NS: PRINT D$;"CHAIN";PX$ +"MAIN"
  134. 61000  REM  *********************
  135. 61010  REM      FILE CABINET
  136. 61020  REM        PRODOS
  137. 61030  REM  ---------------------
  138. 61040  REM      CONVERTED BY
  139. 61050  REM      MICHAEL MOORE
  140. 61060  REM        MAY 1984
  141. 61070  REM  =====================
  142. 61080  REM        BASED ON
  143. 61090  REM  FILE CABINET-MACH 5
  144. 61100  REM    BY ED AYMOND
  145. 61110  REM   AND BOB MATZINGER   
  146. 61120  REM    AS A MODIFICATION
  147. 61130  REM  OF EARLIER VERSIONS
  148. 61140  REM  *********************
  149. 61150  REM  APPLE CORPS OF DALLAS